#!/usr/bin/perl

=head1 NAME

maintain.pl - keep email database nice and tidy

=head1 DESCRIPTION

Rotates old log entries out of the database log.  For our pupposes, anything
older than a year is useless.

=head1 DEPENDENCIES

L<MLDBM>

=cut

#
# Author: Charles Mauch (cmauch@gmail.com)
# Description: Parses mailfilter database to nuke old data
# Legal: (c) 2006 Charles Mauch, released under the terms of the GPLv2 or later

require configvars;                  # Found via PERL5LIB env variable
use MLDBM qw( DB_File Storable );    # use Storable for serializing
use Fcntl qw(:DEFAULT);
use POSIX qw(strftime);
use strict;

=head1 SYNOPSIS

  perl maintain.pl

=cut

our ( %database, %newdatabase );
my $datafile    = $MauchConfig::maildatabase;
my $newdatafile = $MauchConfig::maildatabase . '.tmp';
my $current     = time;
my $cutoff      = $current - 31536000;                   # Older that a year? Gone!

unlink $newdatafile;                                     # Nuke any old copies (if any)

tie %database,    'MLDBM', $datafile,    O_CREAT | O_RDWR, 0640 or die "Cannot open $datafile $!\n";
tie %newdatabase, 'MLDBM', $newdatafile, O_CREAT | O_RDWR, 0640 or die "Cannot open $newdatafile $!\n";

for my $record ( keys %database ) {
    my $ref    = $database{ $record };                   # Create Hash Reference to old records
    my $newref = $newdatabase{ $record };                # And the New ones

    if ( $ref->{ 'date' } > $cutoff ) {                  # Now xfer them if newer than a year
        $newref->{ 'date' }    = $ref->{ 'date' };
        $newref->{ 'score' }   = $ref->{ 'score' };
        $newref->{ 'type' }    = $ref->{ 'type' };
        $newref->{ 'from' }    = $ref->{ 'from' };
        $newref->{ 'email' }   = $ref->{ 'email' };
        $newref->{ 'subject' } = $ref->{ 'subject' };
        $newref->{ 'folder' }  = $ref->{ 'folder' };
    } ## end if ( $ref->{ 'date' } ...
    $newdatabase{ $record } = $newref;                   # Store it!
} ## end for my $record ( keys %database)

untie %database;
untie %newdatabase;

rename( $newdatafile, $datafile ) or die "Can't swap database files: $!";

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests to C<cmauch@gmail.com>

=head1 AUTHOR

Charles Mauch <cmauch@gmail.com>

=head1 LICENSE

Copyright (c) 2006 Charles Mauch

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 SEE ALSO

perl(1).

=cut

# $Id$
